home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr28 / dats520.zip / MAKEDAT.BAS < prev    next >
BASIC Source File  |  1995-02-13  |  2KB  |  69 lines
  1. DECLARE FUNCTION Rstr$ (Num%)
  2. DECLARE SUB WriteDate (Dat$, File$, Locat%)
  3. DEFINT A-Z
  4. 'Program to make "DateChk.dat"
  5. 'Type Definitions
  6. TYPE HolRec
  7.    Date AS STRING * 2
  8.    Text AS STRING * 60
  9. END TYPE
  10.  
  11. 'Declare Constant Program Conditions
  12. CONST False = 0, True = NOT False, ErrorCondition = 0
  13. DIM SHARED Byte(3) AS STRING * 1, RWByte AS STRING * 1, Record AS HolRec
  14.  
  15. 'Program Loop
  16. OPEN "DATECHK.DAT" FOR BINARY AS 1 LEN = 62
  17. IF LOF(1) < 6 THEN
  18.    Rec = 6
  19. ELSE
  20.    Rec = LOF(1) + 1
  21. END IF
  22. DO
  23.    INPUT "Enter Month (-1 to exit): ", Da%
  24.    IF Day = -1 THEN EXIT DO
  25.    INPUT "Enter Day (-1 to exit:", Mo%
  26.    IF Month = -1 THEN EXIT DO
  27.    INPUT "Enter Text(60 char max): ", Text$
  28.    LSET Record.Text = Text$
  29.    Da$ = Rstr$(Da%)
  30.    Mo$ = Rstr$(Mo%)
  31.    IF LEN(Da$) = 1 THEN
  32.       Da$ = "0" + Da$
  33.    END IF
  34.    IF LEN(Mo$) = 1 THEN
  35.       Mo$ = "0" + Mo$
  36.    END IF
  37.    Dat$ = Mo$ + "-" + Da$ + "-1980"
  38.    CALL WriteDate(Dat$, "DATECHK.DAT", Rec)
  39.    PUT #1, Rec, Record
  40.    Rec = Rec + 62
  41. LOOP
  42. CLOSE
  43.  
  44. FUNCTION Rstr$ (Num)
  45.    Num$ = STR$(Num)
  46.    FOR Y = 1 TO LEN(Num$)
  47.       Chec$ = MID$(Num$, Y, 1)
  48.       IF Chec$ <> " " THEN
  49.          NewNum$ = NewNum$ + Chec$
  50.       END IF
  51.    NEXT
  52.    Rstr$ = NewNum$
  53. END FUNCTION
  54.  
  55. SUB WriteDate (Dat$, File$, Locat)
  56.    Fil% = FREEFILE
  57.    OPEN File$ FOR BINARY AS Fil%
  58.       Mo% = VAL(MID$(Dat$, 1, 2))
  59.       Da% = VAL(MID$(Dat$, 4, 2))
  60.       Yr% = VAL(MID$(Dat$, 7, 4)) - 1980
  61.       Byte(1) = CHR$(Mo% * 16 + (Da% AND 30) / 2)
  62.       Byte(2) = CHR$((Da% AND 1) * 128 + Yr%)
  63.       FOR x = 1 TO 2
  64.          PUT #1, x - 1 + Locat, Byte(x)
  65.       NEXT
  66.    CLOSE Fil%
  67. END SUB
  68.  
  69.